home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 05.zip / BS1 part 5 / PDraw3.0.adf / pdraw_rex.lzh / ADProHotLink.pdrx < prev    next >
Text File  |  1992-06-18  |  3KB  |  117 lines
  1. /*
  2. @N
  3.  
  4. This Genie sends a bitmap to Art Department Professional and reimport the bitmap when Art Department Professional quits.
  5. */
  6. msg = PDSetup.rexx(2,0)
  7. units = getclip(pds_units)
  8. if msg ~= 1 then exit_msg(msg)
  9.  
  10. call setclip(pduser_adclip, "")
  11. cr = '0a'x
  12. options results
  13.  
  14. obj = pdm_ClickOnObj("Click on a bitmap")
  15. if obj = 0 then exit_msg()
  16.  
  17.  
  18. if ~isbitmap(obj) then exit_msg("You must click on a bitmap object")
  19. bitmap = pdm_GetBitMapInfo(obj)
  20. parse var bitmap width '0a'x height '0a'x ox '0a'x oy '0a'x xscale '0a'x yscale '0a'x angle '0a'x fname
  21.  
  22.  
  23. screenmodes.1 = 8
  24. screenmodes.1.1 = "Horizontal Overscan"
  25. screenmodes.2 = 4
  26. screenmodes.2.1 = "PAL"
  27. screenmodes.3 = 1
  28. screenmodes.3.1 = "HIRES"
  29. screenmodes.4 = 2
  30. screenmodes.4.1 = "Interlace"
  31. screenmodes.5 = 16
  32. screenmodes.5.1 = "Vertical Overscan"
  33.  
  34. screenmodes = ''
  35.  
  36. do i = 1 to 5
  37.  interpret compress(screenmodes.i.1) "=" screenmodes.i
  38.  screenmodes = screenmodes || '0a'x || screenmodes.i.1
  39. end
  40. screenmodes = substr(screenmodes, 2)
  41.  
  42. rendermodes = "2"cr"4"cr"8"cr"16"cr"32"cr"64"cr"128"cr"256"cr"AHAM"cr"ARZ0"cr"ARZ1"cr"CUST"cr"EHB"cr"HAM"
  43.  
  44. screenmode  = pdm_SelectFromList("Select Screen Mode..", 25, 5, 1, screenmodes)
  45. if screenmode = '' then exit_msg()
  46.  
  47. mode = 0
  48.  
  49. do while screenmode ~= ''
  50.  
  51.    parse var screenmode val '0a'x screenmode
  52.    mode = mode + value(compress(val))
  53.  
  54. end
  55.  
  56. mode = substr(mode, 2)
  57.  
  58. rendermode  = pdm_SelectFromList("Select Render Mode..", 25, 5, 0, rendermodes)
  59. if rendermode = '' then exit_msg()
  60.  
  61. dimension   = "Width:"width || cr"Height:"height
  62. dimension   = pdm_GetForm("Enter image dimensions", 8, dimension)
  63. if dimension = '' then exit_msg()
  64.  
  65. parse var dimension iwidth '0a'x iheight
  66.  
  67. if ~(datatype(iwidth, n) & datatype(iheight, n)) then exit_msg("Invalid Entry")
  68. address command
  69. adargs = iwidth';'iheight';'rendermode';'fname';'mode
  70. call setclip(ppuser_adargs, adargs)
  71.  
  72. adpro = 'ADPro:ADPro'
  73.  
  74. if ~exists(adpro) then
  75. do
  76.   adpro = pdm_GetFileName("Please locate ADPro..", "","")
  77.   if adpro = '' then exit_msg()
  78. end
  79.  
  80. "run >nil:" "rx rexx:PDADProComm.rexx "
  81.  
  82. if  ~show(p, 'ADPro') then
  83. do
  84.  
  85.      /* this genie will go to sleep until adpro has quit   */
  86.     address command
  87.     adpro ">nil:"
  88.  
  89.     adclip = getclip(ppuser_adclip)
  90.     if adclip ~= "1" then exit_msg("Unable to start ADPro")
  91.  
  92. end
  93. else
  94. do
  95.     call pdm_Inform(1, "ADPro has already started. Click here when finished processing bitmap.",)
  96. end
  97.  
  98. call pdm_PDrawToFront()
  99. call pdm_ShowStatus("Reimporting BitMap..")
  100. posn = pdm_GetObjVisPosn(obj)
  101. call pdm_DeleteObj(obj)
  102. bitmap = pdm_ImportBM(fname, word(posn, 1), word(posn, 2))
  103. call pdm_SetBitMapInfo(bitmap, ox, oy, xscale, yscale, angle)
  104.  
  105. exit_msg()
  106.  
  107. exit_msg: procedure expose units
  108. do
  109.    parse arg message
  110.  
  111.    if message ~= '' then call pdm_Inform(1, message,)
  112.    call pdm_AutoUpdate(1)
  113.    call pdm_SetUnits(units)
  114.    call pdm_ClearStatus()
  115.    exit
  116. end
  117.